home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / lib / tk2.3 / dist / tkBind.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-08-10  |  60.3 KB  |  2,165 lines
  1. /* 
  2.  * tkBind.c --
  3.  *
  4.  *    This file provides procedures that associate Tcl commands
  5.  *    with X events or sequences of X events.
  6.  *
  7.  * Copyright 1989-1991 Regents of the University of California
  8.  * Permission to use, copy, modify, and distribute this
  9.  * software and its documentation for any purpose and without
  10.  * fee is hereby granted, provided that the above copyright
  11.  * notice appear in all copies.  The University of California
  12.  * makes no representations about the suitability of this
  13.  * software for any purpose.  It is provided "as is" without
  14.  * express or implied warranty.
  15.  */
  16.  
  17. #ifndef lint
  18. static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkBind.c,v 1.48 92/08/10 16:55:24 ouster Exp $ SPRITE (Berkeley)";
  19. #endif /* not lint */
  20.  
  21. #include "tkConfig.h"
  22. #include "tkInt.h"
  23.  
  24. /*
  25.  * The structure below represents a binding table.  A binding table
  26.  * represents a domain in which event bindings may occur.  It includes
  27.  * a space of objects relative to which events occur (usually windows,
  28.  * but not always), a history of recent events in the domain, and
  29.  * a set of mappings that associate particular Tcl commands with sequences
  30.  * of events in the domain.  Multiple binding tables may exist at once,
  31.  * either because there are multiple applications open, or because there
  32.  * are multiple domains within an application with separate event
  33.  * bindings for each (for example, each canvas widget has a separate
  34.  * binding table for associating events with the items in the canvas).
  35.  */
  36.  
  37. #define EVENT_BUFFER_SIZE 10
  38. typedef struct BindingTable {
  39.     XEvent eventRing[EVENT_BUFFER_SIZE];/* Circular queue of recent events
  40.                      * (higher indices are for more recent
  41.                      * events). */
  42.     int detailRing[EVENT_BUFFER_SIZE];    /* "Detail" information (keySym or
  43.                      * button or 0) for each entry in
  44.                      * eventRing. */
  45.     int curEvent;            /* Index in eventRing of most recent
  46.                      * event.  Newer events have higher
  47.                      * indices. */
  48.     Tcl_HashTable patternTable;        /* Used to map from an event to a list
  49.                      * of patterns that may match that
  50.                      * event.  Keys are PatternTableKey
  51.                      * structs, values are (PatSeq *). */
  52.     Tcl_HashTable objectTable;        /* Used to map from an object to a list
  53.                      * of patterns associated with that
  54.                      * object.  Keys are ClientData,
  55.                      * values are (PatSeq *). */
  56.     Tcl_Interp *interp;            /* Interpreter in which commands are
  57.                      * executed. */
  58. } BindingTable;
  59.  
  60. /*
  61.  * Structures of the following form are used as keys in the patternTable
  62.  * for a binding table:
  63.  */
  64.  
  65. typedef struct PatternTableKey {
  66.     ClientData object;        /* Identifies object (or class of objects)
  67.                  * relative to which event occurred.  For
  68.                  * example, in the widget binding table for
  69.                  * an application this is the path name of
  70.                  * a widget, or a widget class, or "all". */
  71.     int type;            /* Type of event (from X). */
  72.     int detail;            /* Additional information, such as
  73.                  * keysym or button, or 0 if nothing
  74.                  * additional.*/
  75. } PatternTableKey;
  76.  
  77. /*
  78.  * The following structure defines a pattern, which is matched
  79.  * against X events as part of the process of converting X events
  80.  * into Tcl commands.
  81.  */
  82.  
  83. typedef struct Pattern {
  84.     int eventType;        /* Type of X event, e.g. ButtonPress. */
  85.     int needMods;        /* Mask of modifiers that must be
  86.                  * present (0 means no modifiers are
  87.                  * required). */
  88.     int hateMods;        /* Mask of modifiers that must not be
  89.                  * present (0 means any modifiers are
  90.                  * OK). */
  91.     int detail;            /* Additional information that must
  92.                  * match event.  Normally this is 0,
  93.                  * meaning no additional information
  94.                  * must match.  For KeyPress and
  95.                  * KeyRelease events, a keySym may
  96.                  * be specified to select a
  97.                  * particular keystroke (0 means any
  98.                  * keystrokes).  For button events,
  99.                  * specifies a particular button (0
  100.                  * means any buttons are OK). */
  101. } Pattern;
  102.  
  103. /*
  104.  * The structure below defines a pattern sequence, which consists
  105.  * of one or more patterns.  In order to trigger, a pattern
  106.  * sequence must match the most recent X events (first pattern
  107.  * to most recent event, next pattern to next event, and so on).
  108.  */
  109.  
  110. typedef struct PatSeq {
  111.     int numPats;        /* Number of patterns in sequence
  112.                  * (usually 1). */
  113.     char *command;        /* Command to invoke when this
  114.                  * pattern sequence matches (malloc-ed). */
  115.     int flags;            /* Miscellaneous flag values;  see
  116.                  * below for definitions. */
  117.     struct PatSeq *nextSeqPtr;
  118.                 /* Next in list of all pattern
  119.                  * sequences that have the same
  120.                  * initial pattern.  NULL means
  121.                  * end of list. */
  122.     Tcl_HashEntry *hPtr;    /* Pointer to hash table entry for
  123.                  * the initial pattern.  This is the
  124.                  * head of the list of which nextSeqPtr
  125.                  * forms a part. */
  126.     ClientData object;        /* Identifies object with which event is
  127.                  * associated (e.g. window). */
  128.     struct PatSeq *nextObjPtr;
  129.                 /* Next in list of all pattern
  130.                  * sequences for the same object
  131.                  * (NULL for end of list).  Needed to
  132.                  * implement Tk_DeleteAllBindings. */
  133.     Pattern pats[1];        /* Array of "numPats" patterns.  Only
  134.                  * one element is declared here but
  135.                  * in actuality enough space will be
  136.                  * allocated for "numPats" patterns.
  137.                  * To match, pats[0] must match event
  138.                  * n, pats[1] must match event n-1,
  139.                  * etc. */
  140. } PatSeq;
  141.  
  142. /*
  143.  * Flag values for PatSeq structures:
  144.  *
  145.  * PAT_NEARBY        1 means that all of the events matching
  146.  *            this sequence must occur with nearby X
  147.  *            and Y mouse coordinates and close in time.
  148.  *            This is typically used to restrict multiple
  149.  *            button presses.
  150.  * PAT_PERCENTS        1 means that the command for this pattern
  151.  *            requires percent substitution.  0 means there
  152.  *            are no percents in the command.
  153.  */
  154.  
  155. #define PAT_NEARBY        1
  156. #define PAT_PERCENTS        2
  157.  
  158. /*
  159.  * Constants that define how close together two events must be
  160.  * in milliseconds or pixels to meet the PAT_NEARBY constraint:
  161.  */
  162.  
  163. #define NEARBY_PIXELS        5
  164. #define NEARBY_MS        500
  165.  
  166. /*
  167.  * The data structure and hash table below are used to map from
  168.  * textual keysym names to keysym numbers.  This structure is
  169.  * present here because the corresponding X procedures are
  170.  * ridiculously slow.
  171.  */
  172.  
  173. typedef struct {
  174.     char *name;                /* Name of keysym. */
  175.     KeySym value;            /* Numeric identifier for keysym. */
  176. } KeySymInfo;
  177. KeySymInfo keyArray[] = {
  178. #ifndef lint
  179. #include "ks_names.h"
  180. #endif
  181.     (char *) NULL, 0
  182. };
  183. static Tcl_HashTable keySymTable;    /* Hashed form of above structure. */
  184.  
  185. static int initialized = 0;
  186.  
  187. /*
  188.  * A hash table is kept to map from the string names of event
  189.  * modifiers to information about those modifiers.  The structure
  190.  * for storing this information, and the hash table built at
  191.  * initialization time, are defined below.
  192.  */
  193.  
  194. typedef struct {
  195.     char *name;            /* Name of modifier. */
  196.     int mask;            /* Button/modifier mask value,                             * such as Button1Mask. */
  197.     int flags;            /* Various flags;  see below for
  198.                  * definitions. */
  199. } ModInfo;
  200.  
  201. /*
  202.  * Flags for ModInfo structures:
  203.  *
  204.  * DOUBLE -        Non-zero means duplicate this event,
  205.  *            e.g. for double-clicks.
  206.  * TRIPLE -        Non-zero means triplicate this event,
  207.  *            e.g. for triple-clicks.
  208.  * ANY -        Non-zero means that this event allows
  209.  *            any unspecified modifiers.
  210.  */
  211.  
  212. #define DOUBLE        1
  213. #define TRIPLE        2
  214. #define ANY        4
  215.  
  216. static ModInfo modArray[] = {
  217.     "Control",        ControlMask,    0,
  218.     "Shift",        ShiftMask,    0,
  219.     "Lock",        LockMask,    0,
  220.     "B1",        Button1Mask,    0,
  221.     "Button1",        Button1Mask,    0,
  222.     "B2",        Button2Mask,    0,
  223.     "Button2",        Button2Mask,    0,
  224.     "B3",        Button3Mask,    0,
  225.     "Button3",        Button3Mask,    0,
  226.     "B4",        Button4Mask,    0,
  227.     "Button4",        Button4Mask,    0,
  228.     "B5",        Button5Mask,    0,
  229.     "Button5",        Button5Mask,    0,
  230.     "Mod1",        Mod1Mask,    0,
  231.     "M1",        Mod1Mask,    0,
  232.     "Meta",        Mod1Mask,    0,
  233.     "M",        Mod1Mask,    0,
  234.     "Mod2",        Mod2Mask,    0,
  235.     "M2",        Mod2Mask,    0,
  236.     "Alt",        Mod2Mask,    0,
  237.     "Mod3",        Mod3Mask,    0,
  238.     "M3",        Mod3Mask,    0,
  239.     "Mod4",        Mod4Mask,    0,
  240.     "M4",        Mod4Mask,    0,
  241.     "Mod5",        Mod5Mask,    0,
  242.     "M5",        Mod5Mask,    0,
  243.     "Double",        0,        DOUBLE,
  244.     "Triple",        0,        TRIPLE,
  245.     "Any",        0,        ANY,
  246.     NULL,        0,        0};
  247. static Tcl_HashTable modTable;
  248.  
  249. /*
  250.  * This module also keeps a hash table mapping from event names
  251.  * to information about those events.  The structure, an array
  252.  * to use to initialize the hash table, and the hash table are
  253.  * all defined below.
  254.  */
  255.  
  256. typedef struct {
  257.     char *name;            /* Name of event. */
  258.     int type;            /* Event type for X, such as
  259.                  * ButtonPress. */
  260.     int eventMask;        /* Mask bits (for XSelectInput)
  261.                  * for this event type. */
  262. } EventInfo;
  263.  
  264. /*
  265.  * Note:  some of the masks below are an OR-ed combination of
  266.  * several masks.  This is necessary because X doesn't report
  267.  * up events unless you also ask for down events.  Also, X
  268.  * doesn't report button state in motion events unless you've
  269.  * asked about button events.
  270.  */
  271.  
  272. static EventInfo eventArray[] = {
  273.     "Motion",        MotionNotify,
  274.         ButtonPressMask|PointerMotionMask,
  275.     "Button",        ButtonPress,        ButtonPressMask,
  276.     "ButtonPress",    ButtonPress,        ButtonPressMask,
  277.     "ButtonRelease",    ButtonRelease,
  278.         ButtonPressMask|ButtonReleaseMask,
  279.     "Colormap",        ColormapNotify,        ColormapChangeMask,
  280.     "Enter",        EnterNotify,        EnterWindowMask,
  281.     "Leave",        LeaveNotify,        LeaveWindowMask,
  282.     "Expose",        Expose,            ExposureMask,
  283.     "FocusIn",        FocusIn,        FocusChangeMask,
  284.     "FocusOut",        FocusOut,        FocusChangeMask,
  285.     "Keymap",        KeymapNotify,        KeymapStateMask,
  286.     "Key",        KeyPress,        KeyPressMask,
  287.     "KeyPress",        KeyPress,        KeyPressMask,
  288.     "KeyRelease",    KeyRelease,
  289.         KeyPressMask|KeyReleaseMask,
  290.     "Property",        PropertyNotify,        PropertyChangeMask,
  291.     "ResizeRequest",    ResizeRequest,        ResizeRedirectMask,
  292.     "Circulate",    CirculateNotify,    StructureNotifyMask,
  293.     "Configure",    ConfigureNotify,    StructureNotifyMask,
  294.     "Destroy",        DestroyNotify,        StructureNotifyMask,
  295.     "Gravity",        GravityNotify,        StructureNotifyMask,
  296.     "Map",        MapNotify,        StructureNotifyMask,
  297.     "Reparent",        ReparentNotify,        StructureNotifyMask,
  298.     "Unmap",        UnmapNotify,        StructureNotifyMask,
  299.     "Visibility",    VisibilityNotify,    VisibilityChangeMask,
  300.     "CirculateRequest",    CirculateRequest,    SubstructureRedirectMask,
  301.     "ConfigureRequest",    ConfigureRequest,    SubstructureRedirectMask,
  302.     "MapRequest",    MapRequest,        SubstructureRedirectMask,
  303.     (char *) NULL,    0,            0};
  304. static Tcl_HashTable eventTable;
  305.  
  306. /*
  307.  * The defines and table below are used to classify events into
  308.  * various groups.  The reason for this is that logically identical
  309.  * fields (e.g. "state") appear at different places in different
  310.  * types of events.  The classification masks can be used to figure
  311.  * out quickly where to extract information from events.
  312.  */
  313.  
  314. #define KEY_BUTTON_MOTION    0x1
  315. #define CROSSING        0x2
  316. #define FOCUS            0x4
  317. #define EXPOSE            0x8
  318. #define VISIBILITY        0x10
  319. #define CREATE            0x20
  320. #define MAP            0x40
  321. #define REPARENT        0x80
  322. #define CONFIG            0x100
  323. #define CONFIG_REQ        0x200
  324. #define RESIZE_REQ        0x400
  325. #define GRAVITY            0x800
  326. #define PROP            0x0100
  327. #define SEL_CLEAR        0x2000
  328. #define SEL_REQ            0x4000
  329. #define SEL_NOTIFY        0x8000
  330. #define COLORMAP        0x10000
  331. #define MAPPING            0x20000
  332.  
  333. static int flagArray[LASTEvent] = {
  334.    /* Not used */        0,
  335.    /* Not used */        0,
  336.    /* KeyPress */        KEY_BUTTON_MOTION,
  337.    /* KeyRelease */        KEY_BUTTON_MOTION,
  338.    /* ButtonPress */        KEY_BUTTON_MOTION,
  339.    /* ButtonRelease */        KEY_BUTTON_MOTION,
  340.    /* MotionNotify */        KEY_BUTTON_MOTION,
  341.    /* EnterNotify */        CROSSING,
  342.    /* LeaveNotify */        CROSSING,
  343.    /* FocusIn */        FOCUS,
  344.    /* FocusOut */        FOCUS,
  345.    /* KeymapNotify */        0,
  346.    /* Expose */            EXPOSE,
  347.    /* GraphicsExpose */        EXPOSE,
  348.    /* NoExpose */        0,
  349.    /* VisibilityNotify */    VISIBILITY,
  350.    /* CreateNotify */        CREATE,
  351.    /* DestroyNotify */        0,
  352.    /* UnmapNotify */        0,
  353.    /* MapNotify */        MAP,
  354.    /* MapRequest */        0,
  355.    /* ReparentNotify */        REPARENT,
  356.    /* ConfigureNotify */    CONFIG,
  357.    /* ConfigureRequest */    CONFIG_REQ,
  358.    /* GravityNotify */        0,
  359.    /* ResizeRequest */        RESIZE_REQ,
  360.    /* CirculateNotify */    0,
  361.    /* CirculateRequest */    0,
  362.    /* PropertyNotify */        PROP,
  363.    /* SelectionClear */        SEL_CLEAR,
  364.    /* SelectionRequest */    SEL_REQ,
  365.    /* SelectionNotify */    SEL_NOTIFY,
  366.    /* ColormapNotify */        COLORMAP,
  367.    /* ClientMessage */        0,
  368.    /* MappingNotify */        MAPPING
  369. };
  370.  
  371. /*
  372.  * Forward declarations for procedures defined later in this
  373.  * file:
  374.  */
  375.  
  376. static char *        ExpandPercents _ANSI_ARGS_((char *before,
  377.                 XEvent *eventPtr, KeySym keySym, char *after,
  378.                 int afterSize));
  379. static PatSeq *        FindSequence _ANSI_ARGS_((Tcl_Interp *interp,
  380.                 BindingTable *bindPtr, ClientData object,
  381.                 char *eventString, int create,
  382.                 unsigned long *maskPtr));
  383. static char *        GetField _ANSI_ARGS_((char *p, char *copy, int size));
  384. static KeySym        GetKeySym _ANSI_ARGS_((TkDisplay *dispPtr,
  385.                 XEvent *eventPtr));
  386. static PatSeq *        MatchPatterns _ANSI_ARGS_((BindingTable *bindPtr,
  387.                 PatSeq *psPtr));
  388.  
  389. /*
  390.  *--------------------------------------------------------------
  391.  *
  392.  * Tk_CreateBindingTable --
  393.  *
  394.  *    Set up a new domain in which event bindings may be created.
  395.  *
  396.  * Results:
  397.  *    The return value is a token for the new table, which must
  398.  *    be passed to procedures like Tk_CreatBinding.
  399.  *
  400.  * Side effects:
  401.  *    Memory is allocated for the new table.
  402.  *
  403.  *--------------------------------------------------------------
  404.  */
  405.  
  406. Tk_BindingTable
  407. Tk_CreateBindingTable(interp)
  408.     Tcl_Interp *interp;        /* Interpreter to associate with the binding
  409.                  * table:  commands are executed in this
  410.                  * interpreter. */
  411. {
  412.     register BindingTable *bindPtr;
  413.     int i;
  414.  
  415.     /*
  416.      * If this is the first time a binding table has been created,
  417.      * initialize the global data structures.
  418.      */
  419.  
  420.     if (!initialized) {
  421.     register KeySymInfo *kPtr;
  422.     register Tcl_HashEntry *hPtr;
  423.     register ModInfo *modPtr;
  424.     register EventInfo *eiPtr;
  425.     int dummy;
  426.  
  427.     initialized = 1;
  428.     
  429.     Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS);
  430.     for (kPtr = keyArray; kPtr->name != NULL; kPtr++) {
  431.         hPtr = Tcl_CreateHashEntry(&keySymTable, kPtr->name, &dummy);
  432.         Tcl_SetHashValue(hPtr, kPtr->value);
  433.     }
  434.     
  435.     Tcl_InitHashTable(&modTable, TCL_STRING_KEYS);
  436.     for (modPtr = modArray; modPtr->name != NULL; modPtr++) {
  437.         hPtr = Tcl_CreateHashEntry(&modTable, modPtr->name, &dummy);
  438.         Tcl_SetHashValue(hPtr, modPtr);
  439.     }
  440.     
  441.     Tcl_InitHashTable(&eventTable, TCL_STRING_KEYS);
  442.     for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
  443.         hPtr = Tcl_CreateHashEntry(&eventTable, eiPtr->name, &dummy);
  444.         Tcl_SetHashValue(hPtr, eiPtr);
  445.     }
  446.     }
  447.  
  448.     /*
  449.      * Create and initialize a new binding table.
  450.      */
  451.  
  452.     bindPtr = (BindingTable *) ckalloc(sizeof(BindingTable));
  453.     for (i = 0; i < EVENT_BUFFER_SIZE; i++) {
  454.     bindPtr->eventRing[i].type = -1;
  455.     }
  456.     bindPtr->curEvent = 0;
  457.     Tcl_InitHashTable(&bindPtr->patternTable,
  458.         sizeof(PatternTableKey)/sizeof(int));
  459.     Tcl_InitHashTable(&bindPtr->objectTable, TCL_ONE_WORD_KEYS);
  460.     bindPtr->interp = interp;
  461.     return (Tk_BindingTable) bindPtr;
  462. }
  463.  
  464. /*
  465.  *--------------------------------------------------------------
  466.  *
  467.  * Tk_DeleteBindingTable --
  468.  *
  469.  *    Destroy a binding table and free up all its memory.
  470.  *    The caller should not use bindingTable again after
  471.  *    this procedure returns.
  472.  *
  473.  * Results:
  474.  *    None.
  475.  *
  476.  * Side effects:
  477.  *    Memory is freed.
  478.  *
  479.  *--------------------------------------------------------------
  480.  */
  481.  
  482. void
  483. Tk_DeleteBindingTable(bindingTable)
  484.     Tk_BindingTable bindingTable;    /* Token for the binding table to
  485.                      * destroy. */
  486. {
  487.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  488.     PatSeq *psPtr, *nextPtr;
  489.     Tcl_HashEntry *hPtr;
  490.     Tcl_HashSearch search;
  491.  
  492.     /*
  493.      * Find and delete all of the patterns associated with the binding
  494.      * table.
  495.      */
  496.  
  497.     for (hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search);
  498.         hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  499.     for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
  500.         psPtr != NULL; psPtr = nextPtr) {
  501.         nextPtr = psPtr->nextSeqPtr;
  502.         Tk_EventuallyFree((ClientData) psPtr->command,
  503.             (Tk_FreeProc *) free);
  504.         ckfree((char *) psPtr);
  505.     }
  506.     }
  507.  
  508.     /*
  509.      * Clean up the rest of the information associated with the
  510.      * binding table.
  511.      */
  512.  
  513.     Tcl_DeleteHashTable(&bindPtr->patternTable);
  514.     Tcl_DeleteHashTable(&bindPtr->objectTable);
  515.     ckfree((char *) bindPtr);
  516. }
  517.  
  518. /*
  519.  *--------------------------------------------------------------
  520.  *
  521.  * Tk_CreateBinding --
  522.  *
  523.  *    Add a binding to a binding table, so that future calls to
  524.  *    Tk_BindEvent may execute the command in the binding.
  525.  *
  526.  * Results:
  527.  *    The return value is 0 if an error occurred while setting
  528.  *    up the binding.  In this case, an error message will be
  529.  *    left in interp->result.  If all went well then the return
  530.  *    value is a mask of the event types that must be made
  531.  *    available to Tk_BindEvent in order to properly detect when
  532.  *    this binding triggers.  This value can be used to determine
  533.  *    what events to select for in a window, for example.
  534.  *
  535.  * Side effects:
  536.  *    The new binding may cause future calls to Tk_BindEvent to
  537.  *    behave differently than they did previously.
  538.  *
  539.  *--------------------------------------------------------------
  540.  */
  541.  
  542. unsigned long
  543. Tk_CreateBinding(interp, bindingTable, object, eventString, command, append)
  544.     Tcl_Interp *interp;            /* Used for error reporting. */
  545.     Tk_BindingTable bindingTable;    /* Table in which to create binding. */
  546.     ClientData object;            /* Token for object with which binding
  547.                      * is associated. */
  548.     char *eventString;            /* String describing event sequence
  549.                      * that triggers binding. */
  550.     char *command;            /* Contains Tcl command to execute
  551.                      * when binding triggers. */
  552.     int append;                /* 0 means replace any existing
  553.                      * binding for eventString;  1 means
  554.                      * append to that binding. */
  555. {
  556.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  557.     register PatSeq *psPtr;
  558.     unsigned long eventMask;
  559.  
  560.     psPtr = FindSequence(interp, bindPtr, object, eventString, 1, &eventMask);
  561.     if (psPtr == NULL) {
  562.     return 0;
  563.     }
  564.     if (append && (psPtr->command != NULL)) {
  565.     int length;
  566.     char *new;
  567.  
  568.     length = strlen(psPtr->command) + strlen(command) + 3;
  569.     new = (char *) ckalloc((unsigned) length);
  570.     sprintf(new, "%s; %s", psPtr->command, command);
  571.     Tk_EventuallyFree((ClientData) psPtr->command, (Tk_FreeProc *) free);
  572.     psPtr->command = new;
  573.     } else {
  574.     if (psPtr->command != NULL) {
  575.         Tk_EventuallyFree((ClientData) psPtr->command,
  576.             (Tk_FreeProc *) free);
  577.     }
  578.     psPtr->command = (char *) ckalloc((unsigned) (strlen(command) + 1));
  579.     strcpy(psPtr->command, command);
  580.     }
  581.  
  582.     /*
  583.      * See if the command contains percents and thereby requires
  584.      * percent substitution.
  585.      */
  586.  
  587.     if (strchr(psPtr->command, '%') != NULL) {
  588.     psPtr->flags |= PAT_PERCENTS;
  589.     }
  590.     return eventMask;
  591. }
  592.  
  593. /*
  594.  *--------------------------------------------------------------
  595.  *
  596.  * Tk_DeleteBinding --
  597.  *
  598.  *    Remove an event binding from a binding table.
  599.  *
  600.  * Results:
  601.  *    The result is a standard Tcl return value.  If an error
  602.  *    occurs then interp->result will contain an error message.
  603.  *
  604.  * Side effects:
  605.  *    The binding given by object and eventString is removed
  606.  *    from bindingTable.
  607.  *
  608.  *--------------------------------------------------------------
  609.  */
  610.  
  611. int
  612. Tk_DeleteBinding(interp, bindingTable, object, eventString)
  613.     Tcl_Interp *interp;            /* Used for error reporting. */
  614.     Tk_BindingTable bindingTable;    /* Table in which to delete binding. */
  615.     ClientData object;            /* Token for object with which binding
  616.                      * is associated. */
  617.     char *eventString;            /* String describing event sequence
  618.                      * that triggers binding. */
  619. {
  620.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  621.     register PatSeq *psPtr, *prevPtr;
  622.     unsigned long eventMask;
  623.     Tcl_HashEntry *hPtr;
  624.  
  625.     psPtr = FindSequence(interp, bindPtr, object, eventString, 0, &eventMask);
  626.     if (psPtr == NULL) {
  627.     Tcl_ResetResult(interp);
  628.     return TCL_OK;
  629.     }
  630.  
  631.     /*
  632.      * Unlink the binding from the list for its object, then from the
  633.      * list for its pattern.
  634.      */
  635.  
  636.     hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
  637.     if (hPtr == NULL) {
  638.     panic("Tk_DeleteBinding couldn't find object table entry");
  639.     }
  640.     prevPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
  641.     if (prevPtr == psPtr) {
  642.     Tcl_SetHashValue(hPtr, psPtr->nextObjPtr);
  643.     } else {
  644.     for ( ; ; prevPtr = prevPtr->nextObjPtr) {
  645.         if (prevPtr == NULL) {
  646.         panic("Tk_DeleteBinding couldn't find on object list");
  647.         }
  648.         if (prevPtr->nextObjPtr == psPtr) {
  649.         prevPtr->nextObjPtr = psPtr->nextObjPtr;
  650.         break;
  651.         }
  652.     }
  653.     }
  654.     prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
  655.     if (prevPtr == psPtr) {
  656.     if (psPtr->nextSeqPtr == NULL) {
  657.         Tcl_DeleteHashEntry(psPtr->hPtr);
  658.     } else {
  659.         Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
  660.     }
  661.     } else {
  662.     for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
  663.         if (prevPtr == NULL) {
  664.         panic("Tk_DeleteBinding couldn't find on hash chain");
  665.         }
  666.         if (prevPtr->nextSeqPtr == psPtr) {
  667.         prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
  668.         break;
  669.         }
  670.     }
  671.     }
  672.     Tk_EventuallyFree((ClientData) psPtr->command, (Tk_FreeProc *) free);
  673.     ckfree((char *) psPtr);
  674.     return TCL_OK;
  675. }
  676.  
  677. /*
  678.  *--------------------------------------------------------------
  679.  *
  680.  * Tk_GetBinding --
  681.  *
  682.  *    Return the command associated with a given event string.
  683.  *
  684.  * Results:
  685.  *    The return value is a pointer to the command string
  686.  *    associated with eventString for object in the domain
  687.  *    given by bindingTable.  If there is no binding for
  688.  *    eventString, or if eventString is improperly formed,
  689.  *    then NULL is returned and an error message is left in
  690.  *    interp->result.  The return value is semi-static:  it
  691.  *    will persist until the binding is changed or deleted.
  692.  *
  693.  * Side effects:
  694.  *    None.
  695.  *
  696.  *--------------------------------------------------------------
  697.  */
  698.  
  699. char *
  700. Tk_GetBinding(interp, bindingTable, object, eventString)
  701.     Tcl_Interp *interp;            /* Interpreter for error reporting. */
  702.     Tk_BindingTable bindingTable;    /* Table in which to look for
  703.                      * binding. */
  704.     ClientData object;            /* Token for object with which binding
  705.                      * is associated. */
  706.     char *eventString;            /* String describing event sequence
  707.                      * that triggers binding. */
  708. {
  709.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  710.     register PatSeq *psPtr;
  711.     unsigned long eventMask;
  712.  
  713.     psPtr = FindSequence(interp, bindPtr, object, eventString, 0, &eventMask);
  714.     if (psPtr == NULL) {
  715.     return NULL;
  716.     }
  717.     return psPtr->command;
  718. }
  719.  
  720. /*
  721.  *--------------------------------------------------------------
  722.  *
  723.  * Tk_GetAllBindings --
  724.  *
  725.  *    Return a list of event strings for all the bindings
  726.  *    associated with a given object.
  727.  *
  728.  * Results:
  729.  *    There is no return value.  Interp->result is modified to
  730.  *    hold a Tcl list with one entry for each binding associated
  731.  *    with object in bindingTable.  Each entry in the list
  732.  *    contains the event string associated with one binding.
  733.  *
  734.  * Side effects:
  735.  *    None.
  736.  *
  737.  *--------------------------------------------------------------
  738.  */
  739.  
  740. void
  741. Tk_GetAllBindings(interp, bindingTable, object)
  742.     Tcl_Interp *interp;            /* Interpreter for error reporting. */
  743.     Tk_BindingTable bindingTable;    /* Table in which to look for
  744.                      * bindings. */
  745.     ClientData object;            /* Token for object. */
  746.  
  747. {
  748.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  749.     register PatSeq *psPtr;
  750.     register Pattern *patPtr;
  751.     Tcl_HashEntry *hPtr;
  752.     char string[200*EVENT_BUFFER_SIZE];
  753.     register char *p;
  754.     int patsLeft, needMods;
  755.     register ModInfo *modPtr;
  756.  
  757.     hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
  758.     if (hPtr == NULL) {
  759.     return;
  760.     }
  761.     for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
  762.         psPtr = psPtr->nextObjPtr) {
  763.  
  764.     p = string;
  765.  
  766.     /*
  767.      * For each binding, output information about each of the
  768.      * patterns in its sequence.  The order of the patterns in
  769.      * the sequence is backwards from the order in which they
  770.      * must be output.
  771.      */
  772.  
  773.     for (patsLeft = psPtr->numPats,
  774.         patPtr = &psPtr->pats[psPtr->numPats - 1];
  775.         patsLeft > 0; patsLeft--, patPtr--) {
  776.  
  777.         /*
  778.          * Check for simple case of an ASCII character.
  779.          */
  780.  
  781.         if ((patPtr->eventType == KeyPress)
  782.             && (patPtr->needMods == 0)
  783.             && (patPtr->hateMods == ~ShiftMask)
  784.             && isascii(patPtr->detail) && isprint(patPtr->detail)
  785.             && (patPtr->detail != '<')
  786.             && (patPtr->detail != ' ')) {
  787.  
  788.         *p = patPtr->detail;
  789.         p++;
  790.         continue;
  791.         }
  792.  
  793.         /*
  794.          * It's a more general event specification.  First check
  795.          * for "Double" or "Triple", then "Any", then modifiers,
  796.          * the event type, then keysym or button detail.
  797.          */
  798.  
  799.         *p = '<';
  800.         p++;
  801.         if ((patsLeft > 1) && (memcmp((char *) patPtr,
  802.             (char *) (patPtr-1), sizeof(Pattern)) == 0)) {
  803.         patsLeft--;
  804.         patPtr--;
  805.         if ((patsLeft > 1) && (memcmp((char *) patPtr,
  806.             (char *) (patPtr-1), sizeof(Pattern)) == 0)) {
  807.             patsLeft--;
  808.             patPtr--;
  809.             strcpy(p, "Triple-");
  810.         } else {
  811.             strcpy(p, "Double-");
  812.         }
  813.         p += strlen(p);
  814.         }
  815.  
  816.         if (patPtr->hateMods == 0) {
  817.         strcpy(p, "Any-");
  818.         p += strlen(p);
  819.         }
  820.  
  821.         for (needMods = patPtr->needMods, modPtr = modArray;
  822.             needMods != 0; modPtr++) {
  823.         if (modPtr->mask & needMods) {
  824.             needMods &= ~modPtr->mask;
  825.             strcpy(p, modPtr->name);
  826.             p += strlen(p);
  827.             *p = '-';
  828.             p++;
  829.         }
  830.         }
  831.  
  832.         if ((patPtr->eventType != KeyPress)
  833.             || (patPtr->detail == 0)) {
  834.         register EventInfo *eiPtr;
  835.  
  836.         for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
  837.             if (eiPtr->type == patPtr->eventType) {
  838.             strcpy(p, eiPtr->name);
  839.             p += strlen(p);
  840.             if (patPtr->detail != 0) {
  841.                 *p = '-';
  842.                 p++;
  843.             }
  844.             break;
  845.             }
  846.         }
  847.         }
  848.  
  849.         if (patPtr->detail != 0) {
  850.         if ((patPtr->eventType == KeyPress)
  851.             || (patPtr->eventType == KeyRelease)) {
  852.             register KeySymInfo *kPtr;
  853.  
  854.             for (kPtr = keyArray; kPtr->name != NULL; kPtr++) {
  855.             if (patPtr->detail == (int) kPtr->value) {
  856.                 sprintf(p, "%.100s",  kPtr->name);
  857.                 p += strlen(p);
  858.                 break;
  859.             }
  860.             }
  861.         } else {
  862.             sprintf(p, "%d", patPtr->detail);
  863.             p += strlen(p);
  864.         }
  865.         }
  866.         *p = '>';
  867.         p++;
  868.     }
  869.     *p = 0;
  870.     if ((p - string) >= sizeof(string)) {
  871.         panic("Tk_GetAllBindings overflowed buffer");
  872.     }
  873.     Tcl_AppendElement(interp, string, 0);
  874.     }
  875. }
  876.  
  877. /*
  878.  *--------------------------------------------------------------
  879.  *
  880.  * Tk_DeleteAllBindings --
  881.  *
  882.  *    Remove all bindings associated with a given object in a
  883.  *    given binding table.
  884.  *
  885.  * Results:
  886.  *    All bindings associated with object are removed from
  887.  *    bindingTable.
  888.  *
  889.  * Side effects:
  890.  *    None.
  891.  *
  892.  *--------------------------------------------------------------
  893.  */
  894.  
  895. void
  896. Tk_DeleteAllBindings(bindingTable, object)
  897.     Tk_BindingTable bindingTable;    /* Table in which to delete
  898.                      * bindings. */
  899.     ClientData object;            /* Token for object. */
  900. {
  901.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  902.     register PatSeq *psPtr, *prevPtr;
  903.     PatSeq *nextPtr;
  904.     Tcl_HashEntry *hPtr;
  905.  
  906.     hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
  907.     if (hPtr == NULL) {
  908.     return;
  909.     }
  910.     for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
  911.         psPtr = nextPtr) {
  912.     nextPtr  = psPtr->nextObjPtr;
  913.  
  914.     /*
  915.      * Be sure to remove each binding from its hash chain in the
  916.      * pattern table.  If this is the last pattern in the chain,
  917.      * then delete the hash entry too.
  918.      */
  919.  
  920.     prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
  921.     if (prevPtr == psPtr) {
  922.         if (psPtr->nextSeqPtr == NULL) {
  923.         Tcl_DeleteHashEntry(psPtr->hPtr);
  924.         } else {
  925.         Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
  926.         }
  927.     } else {
  928.         for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
  929.         if (prevPtr == NULL) {
  930.             panic("Tk_DeleteAllBindings couldn't find on hash chain");
  931.         }
  932.         if (prevPtr->nextSeqPtr == psPtr) {
  933.             prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
  934.             break;
  935.         }
  936.         }
  937.     }
  938.     Tk_EventuallyFree((ClientData) psPtr->command, (Tk_FreeProc *) free);
  939.     ckfree((char *) psPtr);
  940.     }
  941.     Tcl_DeleteHashEntry(hPtr);
  942. }
  943.  
  944. /*
  945.  *--------------------------------------------------------------
  946.  *
  947.  * Tk_BindEvent --
  948.  *
  949.  *    This procedure is invoked to process an X event.  The
  950.  *    event is added to those recorded for the binding table.
  951.  *    Then each of the objects at *objectPtr is checked in
  952.  *    order to see if it has a binding that matches the recent
  953.  *    events.  If so, that binding is invoked and the rest of
  954.  *    objects are skipped.
  955.  *
  956.  * Results:
  957.  *    None.
  958.  *
  959.  * Side effects:
  960.  *    Depends on the command associated with the matching
  961.  *    binding.
  962.  *
  963.  *--------------------------------------------------------------
  964.  */
  965.  
  966. void
  967. Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
  968.     Tk_BindingTable bindingTable;    /* Table in which to look for
  969.                      * bindings. */
  970.     XEvent *eventPtr;            /* What actually happened. */
  971.     Tk_Window tkwin;            /* Window on display where event
  972.                      * occurred (needed in order to
  973.                      * locate display information). */
  974.     int numObjects;            /* Number of objects at *objectPtr. */
  975.     ClientData *objectPtr;        /* Array of one or more objects
  976.                      * to check for a matching binding. */
  977. {
  978.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  979.     TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
  980.     XEvent *ringPtr;
  981.     PatSeq *matchPtr;
  982.     PatternTableKey key;
  983.     Tcl_HashEntry *hPtr;
  984.     int detail;
  985.  
  986.     /*
  987.      * Add the new event to the ring of saved events for the
  988.      * binding table.  Consecutive MotionNotify events get combined:
  989.      * if both the new event and the previous event are MotionNotify,
  990.      * then put the new event *on top* of the previous event.
  991.      */
  992.  
  993.     if ((eventPtr->type != MotionNotify)
  994.         || (bindPtr->eventRing[bindPtr->curEvent].type != MotionNotify)) {
  995.     bindPtr->curEvent++;
  996.     if (bindPtr->curEvent >= EVENT_BUFFER_SIZE) {
  997.         bindPtr->curEvent = 0;
  998.     }
  999.     }
  1000.     ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
  1001.     memcpy((VOID *) ringPtr, (VOID *) eventPtr, sizeof(XEvent));
  1002.     detail = 0;
  1003.     bindPtr->detailRing[bindPtr->curEvent] = 0;
  1004.     if ((ringPtr->type == KeyPress) || (ringPtr->type == KeyRelease)) {
  1005.     detail = (int) GetKeySym(dispPtr, ringPtr);
  1006.     if (detail == NoSymbol) {
  1007.         detail = 0;
  1008.     }
  1009.     } else if ((ringPtr->type == ButtonPress)
  1010.         || (ringPtr->type == ButtonRelease)) {
  1011.     detail = ringPtr->xbutton.button;
  1012.     }
  1013.     bindPtr->detailRing[bindPtr->curEvent] = detail;
  1014.  
  1015.     /*
  1016.      * Loop over all the objects, matching the new event against
  1017.      * each in turn.
  1018.      */
  1019.  
  1020.     for ( ; numObjects > 0; numObjects--, objectPtr++) {
  1021.  
  1022.     /*
  1023.      * Match the new event against those recorded in the
  1024.      * pattern table, saving the longest matching pattern.
  1025.      * For events with details (button and key events) first
  1026.      * look for a binding for the specific key or button.
  1027.      * If none is found, then look for a binding for all
  1028.      * keys or buttons (detail of 0).
  1029.      */
  1030.     
  1031.     matchPtr = NULL;
  1032.     key.object = *objectPtr;
  1033.     key.type = ringPtr->type;
  1034.     key.detail = detail;
  1035.     hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
  1036.     if (hPtr != NULL) {
  1037.         matchPtr = MatchPatterns(bindPtr,
  1038.             (PatSeq *) Tcl_GetHashValue(hPtr));
  1039.     }
  1040.     if ((detail != 0) && (matchPtr == NULL)) {
  1041.         key.detail = 0;
  1042.         hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
  1043.         if (hPtr != NULL) {
  1044.         matchPtr = MatchPatterns(bindPtr,
  1045.             (PatSeq *) Tcl_GetHashValue(hPtr));
  1046.         }
  1047.     }
  1048.     
  1049.     if (matchPtr != NULL) {
  1050.     
  1051.         /*
  1052.          * %-substitution can increase the length of the command.
  1053.          * This code handles three cases:  (a) no substitution;
  1054.          * (b) substitution results in short command (use space
  1055.          * on stack); and (c) substitution results in long
  1056.          * command (malloc it).
  1057.          */
  1058.     
  1059. #define STATIC_SPACE 200
  1060.         char shortSpace[STATIC_SPACE];
  1061.         int result;
  1062.  
  1063.         if (matchPtr->flags & PAT_PERCENTS) {
  1064.         char *p;
  1065.     
  1066.         p = ExpandPercents(matchPtr->command, eventPtr,
  1067.             (KeySym) detail, shortSpace, STATIC_SPACE);
  1068.         result = Tcl_GlobalEval(bindPtr->interp, p);
  1069.         if (p != shortSpace) {
  1070.             ckfree(p);
  1071.         }
  1072.         } else {
  1073.         /*
  1074.          * The code below is tricky in order allow the binding to
  1075.          * be modified or deleted as part of the command that the
  1076.          * binding invokes.  Must make sure that the actual command
  1077.          * string isn't freed until the command completes, and must
  1078.          * copy the address of this string into a local variable
  1079.          * in case it's modified by the command.
  1080.          */
  1081.  
  1082.         char *cmd = matchPtr->command;
  1083.  
  1084.         Tk_Preserve((ClientData) cmd);
  1085.         result = Tcl_GlobalEval(bindPtr->interp, cmd);
  1086.         Tk_Release((ClientData) cmd);
  1087.         }
  1088.         if (result != TCL_OK) {
  1089.         Tcl_AddErrorInfo(bindPtr->interp,
  1090.             "\n    (command bound to event)");
  1091.         TkBindError(bindPtr->interp);
  1092.         }
  1093.         return;
  1094.     }
  1095.     }
  1096. }
  1097.  
  1098. /*
  1099.  *----------------------------------------------------------------------
  1100.  *
  1101.  * FindSequence --
  1102.  *
  1103.  *    Find the entry in a binding table that corresponds to a
  1104.  *    particular pattern string, and return a pointer to that
  1105.  *    entry.
  1106.  *
  1107.  * Results:
  1108.  *    The return value is normally a pointer to the PatSeq
  1109.  *    in patternTable that corresponds to eventString.  If an error
  1110.  *    was found while parsing eventString, or if "create" is 0 and
  1111.  *    no pattern sequence previously existed, then NULL is returned
  1112.  *    and interp->result contains a message describing the problem.
  1113.  *    If no pattern sequence previously existed for eventString, then
  1114.  *    a new one is created with a NULL command field.  In a successful
  1115.  *    return, *maskPtr is filled in with a mask of the event types
  1116.  *    on which the pattern sequence depends.
  1117.  *
  1118.  * Side effects:
  1119.  *    A new pattern sequence may be created.
  1120.  *
  1121.  *----------------------------------------------------------------------
  1122.  */
  1123.  
  1124. static PatSeq *
  1125. FindSequence(interp, bindPtr, object, eventString, create, maskPtr)
  1126.     Tcl_Interp *interp;        /* Interpreter to use for error
  1127.                  * reporting. */
  1128.     BindingTable *bindPtr;    /* Table to use for lookup. */
  1129.     ClientData object;        /* Token for object(s) with which binding
  1130.                  * is associated. */
  1131.     char *eventString;        /* String description of pattern to
  1132.                  * match on.  See user documentation
  1133.                  * for details. */
  1134.     int create;            /* 0 means don't create the entry if
  1135.                  * it doesn't already exist.   Non-zero
  1136.                  * means create. */
  1137.     unsigned long *maskPtr;    /* *maskPtr is filled in with the event
  1138.                  * types on which this pattern sequence
  1139.                  * depends. */
  1140.  
  1141. {
  1142.     Pattern pats[EVENT_BUFFER_SIZE];
  1143.     int numPats;
  1144.     register char *p;
  1145.     register Pattern *patPtr;
  1146.     register PatSeq *psPtr;
  1147.     register Tcl_HashEntry *hPtr;
  1148. #define FIELD_SIZE 20
  1149.     char field[FIELD_SIZE];
  1150.     int flags, any, count, new, sequenceSize;
  1151.     unsigned long eventMask;
  1152.     PatternTableKey key;
  1153.  
  1154.     /*
  1155.      *-------------------------------------------------------------
  1156.      * Step 1: parse the pattern string to produce an array
  1157.      * of Patterns.  The array is generated backwards, so
  1158.      * that the lowest-indexed pattern corresponds to the last
  1159.      * event that must occur.
  1160.      *-------------------------------------------------------------
  1161.      */
  1162.  
  1163.     p = eventString;
  1164.     flags = 0;
  1165.     eventMask = 0;
  1166.     for (numPats = 0, patPtr = &pats[EVENT_BUFFER_SIZE-1];
  1167.         numPats < EVENT_BUFFER_SIZE;
  1168.         numPats++, patPtr--) {
  1169.     patPtr->eventType = -1;
  1170.     patPtr->needMods = 0;
  1171.     patPtr->hateMods = ~0;
  1172.     patPtr->detail = 0;
  1173.     while (isspace(*p)) {
  1174.         p++;
  1175.     }
  1176.     if (*p == '\0') {
  1177.         break;
  1178.     }
  1179.  
  1180.     /*
  1181.      * Handle simple ASCII characters.  Note:  the shift
  1182.      * modifier is ignored in this case (it's really part
  1183.      * of the character, rather than a "modifier").
  1184.      */
  1185.  
  1186.     if (*p != '<') {
  1187.         char string[2];
  1188.  
  1189.         patPtr->eventType = KeyPress;
  1190.         eventMask |= KeyPressMask;
  1191.         string[0] = *p;
  1192.         string[1] = 0;
  1193.         hPtr = Tcl_FindHashEntry(&keySymTable, string);
  1194.         if (hPtr != NULL) {
  1195.         patPtr->detail = (int) Tcl_GetHashValue(hPtr);
  1196.         } else {
  1197.         if (isprint(*p)) {
  1198.             patPtr->detail = *p;
  1199.         } else {
  1200.             sprintf(interp->result,
  1201.                 "bad ASCII character 0x%x", *p);
  1202.             return NULL;
  1203.         }
  1204.         }
  1205.         patPtr->hateMods = ~ShiftMask;
  1206.         p++;
  1207.         continue;
  1208.     }
  1209.  
  1210.     /*
  1211.      * A fancier event description.  Must consist of
  1212.      * 1. open angle bracket.
  1213.      * 2. any number of modifiers, each followed by spaces
  1214.      *    or dashes.
  1215.      * 3. an optional event name.
  1216.      * 4. an option button or keysym name.  Either this or
  1217.      *    item 3 *must* be present;  if both are present
  1218.      *    then they are separated by spaces or dashes.
  1219.      * 5. a close angle bracket.
  1220.      */
  1221.  
  1222.     any = 0;
  1223.     count = 1;
  1224.     p++;
  1225.     while (1) {
  1226.         register ModInfo *modPtr;
  1227.         p = GetField(p, field, FIELD_SIZE);
  1228.         hPtr = Tcl_FindHashEntry(&modTable, field);
  1229.         if (hPtr == NULL) {
  1230.         break;
  1231.         }
  1232.         modPtr = (ModInfo *) Tcl_GetHashValue(hPtr);
  1233.         patPtr->needMods |= modPtr->mask;
  1234.         if (modPtr->flags & (DOUBLE|TRIPLE)) {
  1235.         flags |= PAT_NEARBY;
  1236.         if (modPtr->flags & DOUBLE) {
  1237.             count = 2;
  1238.         } else {
  1239.             count = 3;
  1240.         }
  1241.         }
  1242.         if (modPtr->flags & ANY) {
  1243.         any = 1;
  1244.         }
  1245.         while ((*p == '-') || isspace(*p)) {
  1246.         p++;
  1247.         }
  1248.     }
  1249.     if (any) {
  1250.         patPtr->hateMods = 0;
  1251.     } else {
  1252.         patPtr->hateMods = ~patPtr->needMods;
  1253.     }
  1254.     hPtr = Tcl_FindHashEntry(&eventTable, field);
  1255.     if (hPtr != NULL) {
  1256.         register EventInfo *eiPtr;
  1257.         eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
  1258.         patPtr->eventType = eiPtr->type;
  1259.         eventMask |= eiPtr->eventMask;
  1260.         while ((*p == '-') || isspace(*p)) {
  1261.         p++;
  1262.         }
  1263.         p = GetField(p, field, FIELD_SIZE);
  1264.     }
  1265.     if (*field != '\0') {
  1266.         if ((*field >= '1') && (*field <= '5') && (field[1] == '\0')) {
  1267.         static int masks[] = {~0, ~Button1Mask, ~Button2Mask,
  1268.             ~Button3Mask, ~Button4Mask, ~Button5Mask};
  1269.  
  1270.         if (patPtr->eventType == -1) {
  1271.             patPtr->eventType = ButtonPress;
  1272.             eventMask |= ButtonPressMask;
  1273.         } else if ((patPtr->eventType == KeyPress)
  1274.             || (patPtr->eventType == KeyRelease)) {
  1275.             goto getKeysym;
  1276.         } else if ((patPtr->eventType != ButtonPress)
  1277.             && (patPtr->eventType != ButtonRelease)) {
  1278.             Tcl_AppendResult(interp, "specified button \"", field,
  1279.                 "\" for non-button event", (char *) NULL);
  1280.             return NULL;
  1281.         }
  1282.         patPtr->detail = (*field - '0');
  1283.  
  1284.         /*
  1285.          * Ignore this button as a modifier:  its state is already
  1286.          * fixed.
  1287.          */
  1288.  
  1289.         patPtr->needMods &= masks[patPtr->detail];
  1290.         patPtr->hateMods &= masks[patPtr->detail];
  1291.         } else {
  1292.         getKeysym:
  1293.         hPtr = Tcl_FindHashEntry(&keySymTable, (char *) field);
  1294.         if (hPtr == NULL) {
  1295.             Tcl_AppendResult(interp, "bad event type or keysym \"",
  1296.                 field, "\"", (char *) NULL);
  1297.             return NULL;
  1298.         }
  1299.         if (patPtr->eventType == -1) {
  1300.             patPtr->eventType = KeyPress;
  1301.             eventMask |= KeyPressMask;
  1302.         } else if ((patPtr->eventType != KeyPress)
  1303.             && (patPtr->eventType != KeyRelease)) {
  1304.             Tcl_AppendResult(interp, "specified keysym \"", field,
  1305.                 "\" for non-key event", (char *) NULL);
  1306.             return NULL;
  1307.         }
  1308.         patPtr->detail = (int) Tcl_GetHashValue(hPtr);
  1309.  
  1310.         /*
  1311.          * Don't get upset about the shift modifier with keys:
  1312.          * if the key doesn't permit the shift modifier then
  1313.          * that will already be factored in when translating
  1314.          * from keycode to keysym in Tk_BindEvent.  If the keysym
  1315.          * has both a shifted and unshifted form, we want to allow
  1316.          * the shifted form to be specified explicitly, though.
  1317.          */
  1318.  
  1319.         patPtr->hateMods &= ~ShiftMask;
  1320.         }
  1321.     } else if (patPtr->eventType == -1) {
  1322.         interp->result = "no event type or button # or keysym";
  1323.         return NULL;
  1324.     }
  1325.     while ((*p == '-') || isspace(*p)) {
  1326.         p++;
  1327.     }
  1328.     if (*p != '>') {
  1329.         interp->result = "missing \">\" in binding";
  1330.         return NULL;
  1331.     }
  1332.     p++;
  1333.  
  1334.     /*
  1335.      * Replicate events for DOUBLE and TRIPLE.
  1336.      */
  1337.  
  1338.     if ((count > 1) && (numPats < EVENT_BUFFER_SIZE-1)) {
  1339.         patPtr[-1] = patPtr[0];
  1340.         patPtr--;
  1341.         numPats++;
  1342.         if ((count == 3) && (numPats < EVENT_BUFFER_SIZE-1)) {
  1343.         patPtr[-1] = patPtr[0];
  1344.         patPtr--;
  1345.         numPats++;
  1346.         }
  1347.     }
  1348.     }
  1349.  
  1350.     /*
  1351.      *-------------------------------------------------------------
  1352.      * Step 2: find the sequence in the binding table if it exists,
  1353.      * and add a new sequence to the table if it doesn't.
  1354.      *-------------------------------------------------------------
  1355.      */
  1356.  
  1357.     if (numPats == 0) {
  1358.     interp->result = "no events specified in binding";
  1359.     return NULL;
  1360.     }
  1361.     patPtr = &pats[EVENT_BUFFER_SIZE-numPats];
  1362.     key.object = object;
  1363.     key.type = patPtr->eventType;
  1364.     key.detail = patPtr->detail;
  1365.     hPtr = Tcl_CreateHashEntry(&bindPtr->patternTable, (char *) &key, &new);
  1366.     sequenceSize = numPats*sizeof(Pattern);
  1367.     if (!new) {
  1368.     for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
  1369.         psPtr = psPtr->nextSeqPtr) {
  1370.         if ((numPats == psPtr->numPats)
  1371.             && ((flags & PAT_NEARBY) == (psPtr->flags & PAT_NEARBY))
  1372.             && (memcmp((char *) patPtr, (char *) psPtr->pats,
  1373.             sequenceSize) == 0)) {
  1374.         goto done;
  1375.         }
  1376.     }
  1377.     }
  1378.     if (!create) {
  1379.     if (new) {
  1380.         Tcl_DeleteHashEntry(hPtr);
  1381.     }
  1382.     Tcl_AppendResult(interp, "no binding exists for \"",
  1383.         eventString, "\"", (char *) NULL);
  1384.     return NULL;
  1385.     }
  1386.     psPtr = (PatSeq *) ckalloc((unsigned) (sizeof(PatSeq)
  1387.         + (numPats-1)*sizeof(Pattern)));
  1388.     psPtr->numPats = numPats;
  1389.     psPtr->command = NULL;
  1390.     psPtr->flags = flags;
  1391.     psPtr->nextSeqPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
  1392.     psPtr->hPtr = hPtr;
  1393.     Tcl_SetHashValue(hPtr, psPtr);
  1394.  
  1395.     /*
  1396.      * Link the pattern into the list associated with the object.
  1397.      */
  1398.  
  1399.     psPtr->object = object;
  1400.     hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object, &new);
  1401.     if (new) {
  1402.     psPtr->nextObjPtr = NULL;
  1403.     } else {
  1404.     psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
  1405.     }
  1406.     Tcl_SetHashValue(hPtr, psPtr);
  1407.  
  1408.     memcpy((VOID *) psPtr->pats, (VOID *) patPtr, sequenceSize);
  1409.  
  1410.     done:
  1411.     *maskPtr = eventMask;
  1412.     return psPtr;
  1413. }
  1414.  
  1415. /*
  1416.  *----------------------------------------------------------------------
  1417.  *
  1418.  * GetField --
  1419.  *
  1420.  *    Used to parse pattern descriptions.  Copies up to
  1421.  *    size characters from p to copy, stopping at end of
  1422.  *    string, space, "-", ">", or whenever size is
  1423.  *    exceeded.
  1424.  *
  1425.  * Results:
  1426.  *    The return value is a pointer to the character just
  1427.  *    after the last one copied (usually "-" or space or
  1428.  *    ">", but could be anything if size was exceeded).
  1429.  *    Also places NULL-terminated string (up to size
  1430.  *    character, including NULL), at copy.
  1431.  *
  1432.  * Side effects:
  1433.  *    None.
  1434.  *
  1435.  *----------------------------------------------------------------------
  1436.  */
  1437.  
  1438. static char *
  1439. GetField(p, copy, size)
  1440.     register char *p;        /* Pointer to part of pattern. */
  1441.     register char *copy;    /* Place to copy field. */
  1442.     int size;            /* Maximum number of characters to
  1443.                  * copy. */
  1444. {
  1445.     while ((*p != '\0') && !isspace(*p) && (*p != '>')
  1446.         && (*p != '-') && (size > 1)) {
  1447.     *copy = *p;
  1448.     p++;
  1449.     copy++;
  1450.     size--;
  1451.     }
  1452.     *copy = '\0';
  1453.     return p;
  1454. }
  1455.  
  1456. /*
  1457.  *----------------------------------------------------------------------
  1458.  *
  1459.  * GetKeySym --
  1460.  *
  1461.  *    Given an X KeyPress or KeyRelease event, map the
  1462.  *    keycode in the event into a KeySym.
  1463.  *
  1464.  * Results:
  1465.  *    The return value is the KeySym corresponding to
  1466.  *    eventPtr, or NoSymbol if no matching Keysym could be
  1467.  *    found.
  1468.  *
  1469.  * Side effects:
  1470.  *    In the first call for a given display, keycode-to-
  1471.  *    KeySym maps get loaded.
  1472.  *
  1473.  *----------------------------------------------------------------------
  1474.  */
  1475.  
  1476. static KeySym
  1477. GetKeySym(dispPtr, eventPtr)
  1478.     register TkDisplay *dispPtr;    /* Display in which to
  1479.                      * map keycode. */
  1480.     register XEvent *eventPtr;        /* Description of X event. */
  1481. {
  1482.     KeySym *symPtr;
  1483.     KeySym sym;
  1484.  
  1485.     /*
  1486.      * Read the key mapping information from the server if
  1487.      * we don't have it already.
  1488.      */
  1489.  
  1490.     if (dispPtr->symsPerCode == 0) {
  1491.     dispPtr->firstKeycode = dispPtr->display->min_keycode;
  1492.     dispPtr->lastKeycode = dispPtr->display->max_keycode;
  1493.     dispPtr->keySyms = XGetKeyboardMapping(dispPtr->display,
  1494.         dispPtr->firstKeycode, dispPtr->lastKeycode + 1
  1495.         - dispPtr->firstKeycode, &dispPtr->symsPerCode);
  1496.     }
  1497.  
  1498.     /*
  1499.      * Compute the lower-case KeySym for this keycode.  May
  1500.      * have to convert an upper-case KeySym to a lower-case
  1501.      * one if the list only has a single element.
  1502.      */
  1503.  
  1504.     if ((eventPtr->xkey.keycode < dispPtr->firstKeycode)
  1505.         || (eventPtr->xkey.keycode > dispPtr->lastKeycode)) {
  1506.     return NoSymbol;
  1507.     }
  1508.     symPtr = &dispPtr->keySyms[(eventPtr->xkey.keycode
  1509.         - dispPtr->firstKeycode) * dispPtr->symsPerCode];
  1510.     sym = *symPtr;
  1511.     if ((dispPtr->symsPerCode == 1) || (symPtr[1] == NoSymbol)) {
  1512.     if ((sym >= XK_A) && (sym <= XK_Z)) {
  1513.         sym += (XK_a - XK_A);
  1514.     } else if ((sym >= XK_Agrave) && (sym <= XK_Odiaeresis)) {
  1515.         sym += (XK_agrave - XK_Agrave);
  1516.     } else if ((sym >= XK_Ooblique) && (sym <= XK_Thorn)) {
  1517.         sym += (XK_oslash - XK_Ooblique);
  1518.     }
  1519.     }
  1520.  
  1521.     /*
  1522.      * See whether the key is shifted or caps-locked.  If so,
  1523.      * use an upper-case equivalent if provided, or compute
  1524.      * one (for caps-lock, just compute upper-case: don't
  1525.      * use shifted KeySym since that would shift non-alphabetic
  1526.      * keys).
  1527.      */
  1528.  
  1529.     if (eventPtr->xkey.state & ShiftMask) {
  1530.     if ((dispPtr->symsPerCode > 1) && (symPtr[1] != NoSymbol)) {
  1531.         return symPtr[1];
  1532.     }
  1533.     shiftToUpper:
  1534.     if ((sym >= XK_a) && (sym <= XK_z)) {
  1535.         sym += (XK_A - XK_a);
  1536.     } else if ((sym >= XK_agrave) && (sym <= XK_adiaeresis)) {
  1537.         sym += (XK_Agrave - XK_agrave);
  1538.     } else if ((sym >= XK_oslash) && (sym <= XK_thorn)) {
  1539.         sym += (XK_Ooblique - XK_oslash);
  1540.     }
  1541.     return sym;
  1542.     }
  1543.     if (eventPtr->xkey.state & LockMask) {
  1544.     goto shiftToUpper;
  1545.     }
  1546.     return sym;
  1547. }
  1548.  
  1549. /*
  1550.  *----------------------------------------------------------------------
  1551.  *
  1552.  * MatchPatterns --
  1553.  *
  1554.  *    Given a list of pattern sequences and a list of
  1555.  *    recent events, return a pattern sequence that matches
  1556.  *    the event list.
  1557.  *
  1558.  * Results:
  1559.  *    The return value is NULL if no pattern matches the
  1560.  *    recent events from bindPtr.  If one or more patterns
  1561.  *    matches, then the longest (or most specific) matching
  1562.  *    pattern is returned.
  1563.  *
  1564.  * Side effects:
  1565.  *    None.
  1566.  *
  1567.  *----------------------------------------------------------------------
  1568.  */
  1569.  
  1570. static PatSeq *
  1571. MatchPatterns(bindPtr, psPtr)
  1572.     BindingTable *bindPtr;    /* Information about binding table, such
  1573.                  * as ring of recent events. */
  1574.     register PatSeq *psPtr;    /* List of pattern sequences. */
  1575. {
  1576.     register PatSeq *bestPtr = NULL;
  1577.  
  1578.     /*
  1579.      * Iterate over all the pattern sequences.
  1580.      */
  1581.  
  1582.     for ( ; psPtr != NULL; psPtr = psPtr->nextSeqPtr) {
  1583.     register XEvent *eventPtr;
  1584.     register Pattern *patPtr;
  1585.     Window window;
  1586.     int *detailPtr;
  1587.     int patCount, ringCount, flags, state;
  1588.  
  1589.     /*
  1590.      * Iterate over all the patterns in a sequence to be
  1591.      * sure that they all match.
  1592.      */
  1593.  
  1594.     eventPtr = &bindPtr->eventRing[bindPtr->curEvent];
  1595.     detailPtr = &bindPtr->detailRing[bindPtr->curEvent];
  1596.     window = eventPtr->xany.window;
  1597.     patPtr = psPtr->pats;
  1598.     patCount = psPtr->numPats;
  1599.     ringCount = EVENT_BUFFER_SIZE;
  1600.     while (patCount > 0) {
  1601.         if (ringCount <= 0) {
  1602.         goto nextSequence;
  1603.         }
  1604.         if (eventPtr->xany.window != window) {
  1605.         goto nextSequence;
  1606.         }
  1607.         if (eventPtr->xany.type != patPtr->eventType) {
  1608.         /*
  1609.          * If the event is a mouse motion, button release,
  1610.          * or key release event, and it didn't match
  1611.          * the pattern, then just skip the event and try
  1612.          * the next event against the same pattern.
  1613.          */
  1614.  
  1615.         if ((eventPtr->xany.type == MotionNotify)
  1616.             || (eventPtr->xany.type == ButtonRelease)
  1617.             || (eventPtr->xany.type == KeyRelease)
  1618.             || (eventPtr->xany.type == NoExpose)
  1619.             || (eventPtr->xany.type == GraphicsExpose)) {
  1620.             goto nextEvent;
  1621.         }
  1622.         goto nextSequence;
  1623.         }
  1624.  
  1625.         flags = flagArray[eventPtr->type];
  1626.         if (flags & KEY_BUTTON_MOTION) {
  1627.         state = eventPtr->xkey.state;
  1628.         } else if (flags & CROSSING) {
  1629.         state = eventPtr->xcrossing.state;
  1630.         } else {
  1631.         state = 0;
  1632.         }
  1633.         if ((state & patPtr->needMods)
  1634.             != patPtr->needMods) {
  1635.         goto nextSequence;
  1636.         }
  1637.         if ((state & patPtr->hateMods) != 0) {
  1638.         goto nextSequence;
  1639.         }
  1640.         if ((patPtr->detail != 0)
  1641.             && (patPtr->detail != *detailPtr)) {
  1642.         goto nextSequence;
  1643.         }
  1644.         if (psPtr->flags & PAT_NEARBY) {
  1645.         register XEvent *firstPtr;
  1646.  
  1647.         firstPtr = &bindPtr->eventRing[bindPtr->curEvent];
  1648.         if ((firstPtr->xkey.x_root
  1649.                 < (eventPtr->xkey.x_root - NEARBY_PIXELS))
  1650.             || (firstPtr->xkey.x_root
  1651.                 > (eventPtr->xkey.x_root + NEARBY_PIXELS))
  1652.             || (firstPtr->xkey.y_root
  1653.                 < (eventPtr->xkey.y_root - NEARBY_PIXELS))
  1654.             || (firstPtr->xkey.y_root
  1655.                 > (eventPtr->xkey.y_root + NEARBY_PIXELS))
  1656.             || (firstPtr->xkey.time
  1657.                 > (eventPtr->xkey.time + NEARBY_MS))) {
  1658.             goto nextSequence;
  1659.         }
  1660.         }
  1661.         patPtr++;
  1662.         patCount--;
  1663.         nextEvent:
  1664.         if (eventPtr == bindPtr->eventRing) {
  1665.         eventPtr = &bindPtr->eventRing[EVENT_BUFFER_SIZE-1];
  1666.         detailPtr = &bindPtr->detailRing[EVENT_BUFFER_SIZE-1];
  1667.         } else {
  1668.         eventPtr--;
  1669.         detailPtr--;
  1670.         }
  1671.         ringCount--;
  1672.     }
  1673.  
  1674.     /*
  1675.      * This sequence matches.  If we've already got another match,
  1676.      * pick whichever is most specific.  Detail is most important,
  1677.      * then needMods, then hateMods.
  1678.      */
  1679.  
  1680.     if (bestPtr != NULL) {
  1681.         register Pattern *patPtr2;
  1682.         int i;
  1683.  
  1684.         if (psPtr->numPats != bestPtr->numPats) {
  1685.         if (bestPtr->numPats > psPtr->numPats) {
  1686.             goto nextSequence;
  1687.         } else {
  1688.             goto newBest;
  1689.         }
  1690.         }
  1691.         for (i = 0, patPtr = psPtr->pats, patPtr2 = bestPtr->pats;
  1692.             i < psPtr->numPats; i++,patPtr++, patPtr2++) {
  1693.         if (patPtr->detail != patPtr2->detail) {
  1694.             if (patPtr->detail == 0) {
  1695.             goto nextSequence;
  1696.             } else {
  1697.             goto newBest;
  1698.             }
  1699.         }
  1700.         if (patPtr->needMods != patPtr2->needMods) {
  1701.             if ((patPtr->needMods & patPtr2->needMods)
  1702.             == patPtr->needMods) {
  1703.             goto nextSequence;
  1704.             } else {
  1705.             goto newBest;
  1706.             }
  1707.         }
  1708.         if (patPtr->hateMods != patPtr2->hateMods) {
  1709.             if ((patPtr->hateMods & patPtr2->hateMods)
  1710.             == patPtr2->hateMods) {
  1711.             goto newBest;
  1712.             } else {
  1713.             goto nextSequence;
  1714.             }
  1715.         }
  1716.         }
  1717.         goto nextSequence;    /* Tie goes to newest pattern. */
  1718.     }
  1719.     newBest:
  1720.     bestPtr = psPtr;
  1721.  
  1722.     nextSequence: continue;
  1723.     }
  1724.     return bestPtr;
  1725. }
  1726.  
  1727. /*
  1728.  *--------------------------------------------------------------
  1729.  *
  1730.  * ExpandPercents --
  1731.  *
  1732.  *    Given a command and an event, produce a new command
  1733.  *    by replacing % constructs in the original command
  1734.  *    with information from the X event.
  1735.  *
  1736.  * Results:
  1737.  *    The return result is a pointer to the new %-substituted
  1738.  *    command.  If the command fits in the space at after, then
  1739.  *    the return value is after.  If the command is too large
  1740.  *    to fit at after, then the return value is a pointer to
  1741.  *    a malloc-ed buffer holding the command;  in this case it
  1742.  *    is the caller's responsibility to free up the buffer when
  1743.  *    finished with it.
  1744.  *
  1745.  * Side effects:
  1746.  *    None.
  1747.  *
  1748.  *--------------------------------------------------------------
  1749.  */
  1750.  
  1751. static char *
  1752. ExpandPercents(before, eventPtr, keySym, after, afterSize)
  1753.     register char *before;    /* Command containing percent
  1754.                  * expressions to be replaced. */
  1755.     register XEvent *eventPtr;    /* X event containing information
  1756.                  * to be used in % replacements. */
  1757.     KeySym keySym;        /* KeySym: only relevant for
  1758.                  * KeyPress and KeyRelease events). */
  1759.     char *after;        /* Place to generate new expanded
  1760.                  * command.  Must contain at least
  1761.                  * "afterSize" bytes of space. */
  1762.     int afterSize;        /* Number of bytes of space available at
  1763.                  * after. */
  1764. {
  1765.     register char *buffer;    /* Pointer to buffer currently being used
  1766.                  * as destination. */
  1767.     register char *dst;        /* Pointer to next place to store character
  1768.                  * in substituted string. */
  1769.     int spaceLeft;        /* Indicates how many more non-null bytes
  1770.                  * may be stored at *dst before space
  1771.                  * runs out. */
  1772.     int spaceNeeded, cvtFlags;    /* Used to substitute string as proper Tcl
  1773.                  * list element. */
  1774.     int number, flags;
  1775. #define NUM_SIZE 40
  1776.     register char *string;
  1777.     char numStorage[NUM_SIZE+1];
  1778.  
  1779.     if (eventPtr->type < LASTEvent) {
  1780.     flags = flagArray[eventPtr->type];
  1781.     } else {
  1782.     flags = 0;
  1783.     }
  1784.     dst = buffer = after;
  1785.     spaceLeft = afterSize - 1;
  1786.     while (*before != 0) {
  1787.     if (*before != '%') {
  1788.  
  1789.         /*
  1790.          * Expand the destination string if necessary.
  1791.          */
  1792.  
  1793.         if (spaceLeft <= 0) {
  1794.         char *newSpace;
  1795.  
  1796.         newSpace = (char *) ckalloc((unsigned) (2*afterSize));
  1797.         memcpy((VOID *) newSpace, (VOID *) buffer, afterSize);
  1798.         afterSize *= 2;
  1799.         dst = newSpace + (dst - buffer);
  1800.         if (buffer != after) {
  1801.             ckfree(buffer);
  1802.         }
  1803.         buffer = newSpace;
  1804.         spaceLeft = afterSize - (dst-buffer) - 1;
  1805.         }
  1806.         *dst = *before;
  1807.         dst++;
  1808.         before++;
  1809.         spaceLeft--;
  1810.         continue;
  1811.     }
  1812.  
  1813.     number = 0;
  1814.     string = "??";
  1815.     switch (before[1]) {
  1816.         case '#':
  1817.         number = eventPtr->xany.serial;
  1818.         goto doNumber;
  1819.         case 'a':
  1820.         number = (int) eventPtr->xconfigure.above;
  1821.         goto doNumber;
  1822.         case 'b':
  1823.         number = eventPtr->xbutton.button;
  1824.         goto doNumber;
  1825.         case 'c':
  1826.         if (flags & EXPOSE) {
  1827.             number = eventPtr->xexpose.count;
  1828.         } else if (flags & MAPPING) {
  1829.             number = eventPtr->xmapping.count;
  1830.         }
  1831.         goto doNumber;
  1832.         case 'd':
  1833.         if (flags & (CROSSING|FOCUS)) {
  1834.             switch (eventPtr->xcrossing.detail) {
  1835.             case NotifyAncestor:
  1836.                 string = "NotifyAncestor";
  1837.                 break;
  1838.             case NotifyVirtual:
  1839.                 string = "NotifyVirtual";
  1840.                 break;
  1841.             case NotifyInferior:
  1842.                 string = "NotifyInferior";
  1843.                 break;
  1844.             case NotifyNonlinear:
  1845.                 string = "NotifyNonlinear";
  1846.                 break;
  1847.             case NotifyNonlinearVirtual:
  1848.                 string = "NotifyNonlinearVirtual";
  1849.                 break;
  1850.             case NotifyPointer:
  1851.                 string = "NotifyPointer";
  1852.                 break;
  1853.             case NotifyPointerRoot:
  1854.                 string = "NotifyPointerRoot";
  1855.                 break;
  1856.             case NotifyDetailNone:
  1857.                 string = "NotifyDetailNone";
  1858.                 break;
  1859.             }
  1860.         } else if (flags & CONFIG_REQ) {
  1861.             switch (eventPtr->xconfigurerequest.detail) {
  1862.             case Above:
  1863.                 string = "Above";
  1864.                 break;
  1865.             case Below:
  1866.                 string = "Below";
  1867.                 break;
  1868.             case TopIf:
  1869.                 string = "TopIf";
  1870.                 break;
  1871.             case BottomIf:
  1872.                 string = "BottomIf";
  1873.                 break;
  1874.             case Opposite:
  1875.                 string = "Opposite";
  1876.                 break;
  1877.             }
  1878.         }
  1879.         goto doString;
  1880.         case 'f':
  1881.         number = eventPtr->xcrossing.focus;
  1882.         goto doNumber;
  1883.         case 'h':
  1884.         if (flags & EXPOSE) {
  1885.             number = eventPtr->xexpose.height;
  1886.         } else if (flags & (CONFIG|CONFIG_REQ)) {
  1887.             number = eventPtr->xconfigure.height;
  1888.         } else if (flags & RESIZE_REQ) {
  1889.             number = eventPtr->xresizerequest.height;
  1890.         }
  1891.         goto doNumber;
  1892.         case 'k':
  1893.         number = eventPtr->xkey.keycode;
  1894.         goto doNumber;
  1895.         case 'm':
  1896.         if (flags & CROSSING) {
  1897.             number = eventPtr->xcrossing.mode;
  1898.         } else if (flags & FOCUS) {
  1899.             number = eventPtr->xfocus.mode;
  1900.         }
  1901.         switch (number) {
  1902.             case NotifyNormal:
  1903.             string = "NotifyNormal";
  1904.             break;
  1905.             case NotifyGrab:
  1906.             string = "NotifyGrab";
  1907.             break;
  1908.             case NotifyUngrab:
  1909.             string = "NotifyUngrab";
  1910.             break;
  1911.             case NotifyWhileGrabbed:
  1912.             string = "NotifyWhileGrabbed";
  1913.             break;
  1914.         }
  1915.         goto doString;
  1916.         case 'o':
  1917.         if (flags & CREATE) {
  1918.             number = eventPtr->xcreatewindow.override_redirect;
  1919.         } else if (flags & MAP) {
  1920.             number = eventPtr->xmap.override_redirect;
  1921.         } else if (flags & REPARENT) {
  1922.             number = eventPtr->xreparent.override_redirect;
  1923.         } else if (flags & CONFIG) {
  1924.             number = eventPtr->xconfigure.override_redirect;
  1925.         }
  1926.         goto doNumber;
  1927.         case 'p':
  1928.         switch (eventPtr->xcirculate.place) {
  1929.             case PlaceOnTop:
  1930.             string = "PlaceOnTop";
  1931.             break;
  1932.             case PlaceOnBottom:
  1933.             string = "PlaceOnBottom";
  1934.             break;
  1935.         }
  1936.         goto doString;
  1937.         case 's':
  1938.         if (flags & KEY_BUTTON_MOTION) {
  1939.             number = eventPtr->xkey.state;
  1940.         } else if (flags & CROSSING) {
  1941.             number = eventPtr->xcrossing.state;
  1942.         } else if (flags & VISIBILITY) {
  1943.             switch (eventPtr->xvisibility.state) {
  1944.             case VisibilityUnobscured:
  1945.                 string = "VisibilityUnobscured";
  1946.                 break;
  1947.             case VisibilityPartiallyObscured:
  1948.                 string = "VisibilityPartiallyObscured";
  1949.                 break;
  1950.             case VisibilityFullyObscured:
  1951.                 string = "VisibilityFullyObscured";
  1952.                 break;
  1953.             }
  1954.             goto doString;
  1955.         }
  1956.         goto doNumber;
  1957.         case 't':
  1958.         if (flags & (KEY_BUTTON_MOTION|PROP|SEL_CLEAR)) {
  1959.             number = (int) eventPtr->xkey.time;
  1960.         } else if (flags & SEL_REQ) {
  1961.             number = (int) eventPtr->xselectionrequest.time;
  1962.         } else if (flags & SEL_NOTIFY) {
  1963.             number = (int) eventPtr->xselection.time;
  1964.         }
  1965.         goto doNumber;
  1966.         case 'v':
  1967.         number = eventPtr->xconfigurerequest.value_mask;
  1968.         goto doNumber;
  1969.         case 'w':
  1970.         if (flags & EXPOSE) {
  1971.             number = eventPtr->xexpose.width;
  1972.         } else if (flags & (CONFIG|CONFIG_REQ)) {
  1973.             number = eventPtr->xconfigure.width;
  1974.         } else if (flags & RESIZE_REQ) {
  1975.             number = eventPtr->xresizerequest.width;
  1976.         }
  1977.         goto doNumber;
  1978.         case 'x':
  1979.         if (flags & KEY_BUTTON_MOTION) {
  1980.             number = eventPtr->xkey.x;
  1981.         } else if (flags & EXPOSE) {
  1982.             number = eventPtr->xexpose.x;
  1983.         } else if (flags & (CREATE|CONFIG|GRAVITY|CONFIG_REQ)) {
  1984.             number = eventPtr->xcreatewindow.x;
  1985.         } else if (flags & REPARENT) {
  1986.             number = eventPtr->xreparent.x;
  1987.         } else if (flags & CROSSING) {
  1988.             number = eventPtr->xcrossing.x;
  1989.         }
  1990.         goto doNumber;
  1991.         case 'y':
  1992.         if (flags & KEY_BUTTON_MOTION) {
  1993.             number = eventPtr->xkey.y;
  1994.         } else if (flags & EXPOSE) {
  1995.             number = eventPtr->xexpose.y;
  1996.         } else if (flags & (CREATE|CONFIG|GRAVITY|CONFIG_REQ)) {
  1997.             number = eventPtr->xcreatewindow.y;
  1998.         } else if (flags & REPARENT) {
  1999.             number = eventPtr->xreparent.y;
  2000.         } else if (flags & CROSSING) {
  2001.             number = eventPtr->xcrossing.y;
  2002.  
  2003.         }
  2004.         goto doNumber;
  2005.         case 'A':
  2006.         if ((eventPtr->type == KeyPress)
  2007.             || (eventPtr->type == KeyRelease)) {
  2008.             int numChars;
  2009.  
  2010.             numChars = XLookupString(&eventPtr->xkey, numStorage,
  2011.                 NUM_SIZE, (KeySym *) NULL,
  2012.                 (XComposeStatus *) NULL);
  2013.             numStorage[numChars] = '\0';
  2014.             string = numStorage;
  2015.         }
  2016.         goto doString;
  2017.         case 'B':
  2018.         number = eventPtr->xcreatewindow.border_width;
  2019.         goto doNumber;
  2020.         case 'D':
  2021.         number = (int) eventPtr->xany.display;
  2022.         goto doNumber;
  2023.         case 'E':
  2024.         number = (int) eventPtr->xany.send_event;
  2025.         goto doNumber;
  2026.         case 'K':
  2027.         if ((eventPtr->type == KeyPress)
  2028.             || (eventPtr->type == KeyRelease)) {
  2029.             register KeySymInfo *kPtr;
  2030.  
  2031.             for (kPtr = keyArray; kPtr->name != NULL; kPtr++) {
  2032.             if (kPtr->value == keySym) {
  2033.                 string = kPtr->name;
  2034.                 break;
  2035.             }
  2036.             }
  2037.         }
  2038.         goto doString;
  2039.         case 'N':
  2040.         number = (int) keySym;
  2041.         goto doNumber;
  2042.         case 'R':
  2043.         number = (int) eventPtr->xkey.root;
  2044.         goto doNumber;
  2045.         case 'S':
  2046.         number = (int) eventPtr->xkey.subwindow;
  2047.         goto doNumber;
  2048.         case 'T':
  2049.         number = eventPtr->type;
  2050.         goto doNumber;
  2051.         case 'W': {
  2052.         TkWindow *winPtr;
  2053.  
  2054.         if (XFindContext(eventPtr->xany.display, eventPtr->xany.window,
  2055.             tkWindowContext, (caddr_t *) &winPtr) == 0) {
  2056.             string = winPtr->pathName;
  2057.         } else {
  2058.             string = "??";
  2059.         }
  2060.         goto doString;
  2061.         }
  2062.         case 'X':
  2063.         number = eventPtr->xkey.x_root;
  2064.         goto doNumber;
  2065.         case 'Y':
  2066.         number = eventPtr->xkey.y_root;
  2067.         goto doNumber;
  2068.         default:
  2069.         numStorage[0] = before[1];
  2070.         numStorage[1] = '\0';
  2071.         string = numStorage;
  2072.         goto doString;
  2073.     }
  2074.  
  2075.     doNumber:
  2076.     sprintf(numStorage, "%d", number);
  2077.     string = numStorage;
  2078.  
  2079.     doString:
  2080.     spaceNeeded = Tcl_ScanElement(string, &cvtFlags);
  2081.     if (spaceNeeded >= spaceLeft) {
  2082.         char *newSpace;
  2083.  
  2084.         newSpace = (char *) ckalloc((unsigned)
  2085.             (afterSize + spaceNeeded + 50));
  2086.         memcpy((VOID *) newSpace, (VOID *) buffer, afterSize);
  2087.         afterSize += spaceNeeded + 50;
  2088.         dst = newSpace + (dst - buffer);
  2089.         if (buffer != after) {
  2090.         ckfree(buffer);
  2091.         }
  2092.         buffer = newSpace;
  2093.         spaceLeft = afterSize - (dst-buffer) - 1;
  2094.     }
  2095.     spaceNeeded = Tcl_ConvertElement(string, dst,
  2096.         cvtFlags | TCL_DONT_USE_BRACES);
  2097.     dst += spaceNeeded;
  2098.     spaceLeft -= spaceNeeded;
  2099.     before += 2;
  2100.     }
  2101.     *dst = '\0';
  2102.     return buffer;
  2103. }
  2104.  
  2105. /*
  2106.  *----------------------------------------------------------------------
  2107.  *
  2108.  * TkBindError --
  2109.  *
  2110.  *    This procedure is invoked to handle errors that occur in Tcl
  2111.  *    commands that are invoked in "background" (e.g. from event or
  2112.  *    timer bindings).
  2113.  *
  2114.  * Results:
  2115.  *    None.
  2116.  *
  2117.  * Side effects:
  2118.  *    The command "tkerror" is invoked to process the error, passing
  2119.  *    it the error message.  If that fails, then an error message
  2120.  *    is output on stderr.
  2121.  *
  2122.  *----------------------------------------------------------------------
  2123.  */
  2124.  
  2125. void
  2126. TkBindError(interp)
  2127.     Tcl_Interp *interp;        /* Interpreter in which an error has
  2128.                  * occurred. */
  2129. {
  2130.     char *argv[2];
  2131.     char *command;
  2132.     char *error;
  2133.     char *errorInfo, *tmp;
  2134.     int result;
  2135.  
  2136.     error = (char *) ckalloc((unsigned) (strlen(interp->result) + 1));
  2137.     strcpy(error, interp->result);
  2138.     tmp = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
  2139.     if (tmp == NULL) {
  2140.     errorInfo = error;
  2141.     } else {
  2142.     errorInfo = (char *) ckalloc((unsigned) (strlen(tmp) + 1));
  2143.     strcpy(errorInfo, tmp);
  2144.     }
  2145.     argv[0] = "tkerror";
  2146.     argv[1] = error;
  2147.     command = Tcl_Merge(2, argv);
  2148.     result = Tcl_GlobalEval(interp, command);
  2149.     if (result != TCL_OK) {
  2150.     if (strcmp(interp->result, "\"tkerror\" is an invalid command name or ambiguous abbreviation") == 0) {
  2151.         fprintf(stderr, "%s\n", errorInfo);
  2152.     } else {
  2153.         fprintf(stderr, "tkerror failed to handle background error.\n");
  2154.         fprintf(stderr, "    Original error: %s\n", error);
  2155.         fprintf(stderr, "    Error in tkerror: %s\n", interp->result);
  2156.     }
  2157.     }
  2158.     Tcl_ResetResult(interp);
  2159.     ckfree(command);
  2160.     ckfree(error);
  2161.     if (errorInfo != error) {
  2162.     ckfree(errorInfo);
  2163.     }
  2164. }
  2165.